home *** CD-ROM | disk | FTP | other *** search
/ Power Bytes: Money & Finance / PowerBytes Money and Finance CD-ROM 01 / PowerBytes Money and Finance CD-ROM 01.iso / HyperCard Files / Mathematics / Fractals / fractal2.a < prev    next >
Encoding:
Text File  |  1987-11-04  |  12.0 KB  |  466 lines  |  [TEXT/ttxt]
  1. ;
  2. ;    fractal xcmd v0.3 -- Doug Felt, Oct 14, 1987
  3. ;    
  4. ;    This draws a fractal on the screen.  Not to the card, yet.  Function is
  5. ;    f(z) = z * z + c, julia set mapped to 4 patterns.
  6. ;    
  7. ;    Format:
  8. ;         Fractal seed.h seed.v [res = 8 [limit = 32 [lock = 0]]]
  9. ;         
  10. ;    seed is the complex constant c (v imaginary)
  11. ;    res is the number of pixels on a side for the point to plot 
  12. ;    limit is the max number of iterations (best between 16 & 128, multiple of 4),
  13. ;    lower limit means most complex regions of the fractal are white
  14. ;    if lock is 0, pressing the mouse will immediately stop the drawing, otherwise
  15. ;    pressing the mouse has no effect and drawing can only be stopped by reboot or
  16. ;    fancy macsbug work.
  17. ;   
  18. ;    Doug Felt, AIR/CAT Project
  19. ;    duggie@jessica.stanford.edu
  20. ;
  21. ;    
  22. ;    To compile and link in MPW C:
  23. ;
  24. ;    C -q2 Fractal.c
  25. ;    link -sn Main=Fractal -sn STDIO=Fractal ╢
  26. ;         -sn INTENV=Fractal -rt XCMD=104 ╢
  27. ;         -m FRACTAL Fractal.c.o "{CLibraries}CRunTime.o" ╢
  28. ;         -o HyperCommands
  29. ;
  30. ;
  31. ;        Well now, I thought this was so neat, and Doug was right it needs a 
  32. ;    little more speed. So thats what I did, I rewrote the "C" program in 
  33. ;    assembler with direct processing on the MC68881 FPU. I think this makes
  34. ;    quite a difference. The only thing is that it only runs on a MacII. It
  35. ;    might run on one or more of the accelerator cards. Give it a try. If 
  36. ;    necessary, change the COID= parameter below if they are using other than 1.
  37. ;
  38. ;                    Ray Sanders
  39. ;                Green Grass Software, Inc.
  40. ;
  41. ;            CIS: 70277,3233     GEnie: RAYSANDERS
  42. ;
  43. ;    To assemble and link with MPW:
  44. ;
  45. ;                fractal2.a.o ─ fractal2.make fractal2.a
  46. ;                    Asm fractal2.a -l -font Monaco,9
  47. ;                fractal2 ─ fractal2.make fractal2.a.o
  48. ;                    link -o fractal2 -rt XCMD=105 -sn Main=Fractal2 -t STAK -c WILD ╢
  49. ;                        fractal2.a.o ╢
  50. ;                        -o "Fractals"
  51. ;
  52. ;
  53. fractal2    MAIN
  54.         
  55.         BLANKS        ON
  56.         STRING        ASIS
  57.         MC68881        COID=1,PREC=X,ROUND=N
  58. ;         INCLUDE        'Traps.a'
  59. ;         INCLUDE        'SysEqu.a'
  60.         PRINT        OFF
  61.          INCLUDE        'Traps.a'
  62.          INCLUDE        'SysEqu.a'
  63.         PRINT        ON,NOWARN
  64. ;        PRINT        ON
  65.  
  66.  
  67. ; HyperCard data structure offsets
  68.  
  69. XCmdParamCount    EQU        0                ;number of parameters
  70. XCmdParams        EQU        2                ;16 handles to C-strings
  71. XCmdReturnVal    EQU        66                ;handle to return string
  72. XCmdPassFlag    EQU        70                ;boolean, to pass message through
  73. XCmdEntryPoint    EQU        72                ;hyperCard call-back
  74. XCmdRequest        EQU        76                ;call back opcode field
  75. XCmdResult        EQU        78                ;call back result field
  76. XCmdInArgs        EQU        80                ;8 longs, input arguments
  77. XCmdOutArgs        EQU        112                ;4 longs, output arguments
  78.  
  79. MenuList        EQU        $A1C
  80.  
  81. ;    result codes
  82.  
  83. xresSucc             EQU        0
  84. xresFail             EQU        1 
  85. xresNotImp             EQU        2 
  86.  
  87. ;    request codes
  88.  
  89. xreqSendCardMessage        EQU        1 
  90. xreqEvalExpr            EQU        2 
  91. xreqStringLength        EQU        3 
  92. xreqStringMatch            EQU        4 
  93. xreqSendHCMessage        EQU        5
  94. xreqZeroBytes             EQU        6 
  95. xreqPasToZero            EQU        7 
  96. xreqZeroToPas            EQU        8 
  97. xreqStrToLong            EQU        9 
  98. xreqStrToNum            EQU        10 
  99. xreqStrToBool            EQU        11 
  100. xreqStrToExt            EQU        12 
  101. xreqLongToStr            EQU        13 
  102. xreqNumToStr            EQU        14 
  103. xreqNumToHex            EQU        15 
  104. xreqBoolToStr            EQU        16 
  105. xreqExtToStr            EQU        17 
  106. xreqGetGlobal            EQU        18 
  107. xreqSetGlobal            EQU        19 
  108. xreqGetFieldByName        EQU        20 
  109. xreqGetFieldByNum        EQU        21 
  110. xreqGetFieldByID        EQU        22 
  111. xreqSetFieldByName        EQU        23 
  112. xreqSetFieldByNum        EQU        24 
  113. xreqSetFieldByID        EQU        25 
  114. xreqStringEqual           EQU        26 
  115. xreqReturnToPas           EQU        27 
  116. xreqScanToReturn          EQU        28 
  117. xreqScanToZero            EQU        39   ;    was suppose to be 29!  Oops!
  118.  
  119.  
  120. ; definition of stack frame
  121.  
  122. stackStor    RECORD    0,DECREMENT
  123. stackStorStart    EQU        *
  124. xcmdBlockAddr    DS.L    1
  125. noLock            DS.W    1
  126. res                DS.W    1
  127. hsize            DS.W    1
  128. vsize            DS.W    1
  129. i                DS.W    1
  130. j                DS.W    1
  131. iter            DS.W    1
  132. limit            DS.W    1
  133. rbaseh            DS.W    1
  134. rat                DS.L    3
  135. seedh            DS.L    3
  136. seedv            DS.L    3
  137. valh            DS.L    3
  138. valv            DS.L    3
  139. temp            DS.L    3
  140. basev            DS.L    3
  141. baseh            DS.L    3
  142. hsq                DS.L    3
  143. vsq                DS.L    3
  144. real2            DS.L    3
  145. realn2            DS.L    3
  146. real100            DS.L    3
  147. fake256            DS.L    1
  148. fake171            DS.L    1
  149. fake2            DS.L    1
  150. fake100            DS.L    1
  151. r                DS.W    4
  152. pats            DS.L    8
  153. tempX            DS.L    3
  154. tempStr            DS.B    256
  155. tempL            DS.L    1
  156. stackStorLen    EQU     *-stackStorStart 
  157.             ENDR
  158.  
  159.             WITH stackStor
  160. EntryPoint
  161. ;;;        _Debugger                            ;
  162.         LINK    A6,#stackStorLen            ;
  163.         MOVEM.L    A0-A6/D0-D7,-(SP)            ;
  164.     
  165.         MOVE.L    8(A6),A3                    ;
  166.         MOVE.L    A3,xcmdBlockAddr(A6)        ;
  167.         
  168.         CMPI.W    #3,XCmdParamCount(A3)        ; if (paramPtr->paramCount<2) return
  169.         BLT        FracsDone                    ;
  170.         
  171.         MOVE.L    #$00000000,pats(A6)            ; pats[0].long1 = 0
  172.         MOVE.L    #$00000000,pats+4(A6)        ; pats[0].long2 = 0
  173.         MOVE.L    #$AA005500,pats+8(A6)        ; pats[1].long1 = 0xaa005500
  174.         MOVE.L    #$AA005500,pats+12(A6)        ; pats[1].long2 = 0xaa005500
  175.         MOVE.L    #$55FFAAFF,pats+16(A6)        ; pats[2].long1 = 0x55ffaaff
  176.         MOVE.L    #$55FFAAFF,pats+20(A6)        ; pats[2].long2 = 0x55ffaaff
  177.         MOVE.L    #$FFFFFFFF,pats+24(A6)        ; pats[3].long1 = 0xffffffff
  178.         MOVE.L    #$FFFFFFFF,pats+28(A6)        ; pats[3].long2 = 0xffffffff
  179.         
  180.         MOVE.W    #8,res(A6)                    ; res = 8
  181.         
  182.         MOVE.W    #32,limit(A6)                ; limit = 32
  183.         
  184.         MOVE.W    #1,nolock(A6)                ; nolock = 1
  185.  
  186.         MOVE.L    XCmdParams(A3),-(SP)        ; seedh = ParamToExt(paramPtr,0)
  187.         PEA.L    seedh(A6)                    ;
  188.         BSR        ZeroToExt                    ;
  189.         ADDQ.L    #8,SP                        ;
  190.         
  191.         MOVE.L    XCmdParams+4(A3),-(SP)        ; seedv = ParamToExt(paramPtr,1)
  192.         PEA.L    seedv(A6)                    ;
  193.         BSR        ZeroToExt                    ;
  194.         ADDQ.L    #8,SP                        ;
  195.  
  196.         CMPI.W    #3,XCmdParamCount(A3)        ; if (paramPtr->paramCount>2)
  197.         BLT        @150                        ;
  198.         MOVE.L    XCmdParams+8(A3),-(SP)        ; res = ParamToNum(paramPtr,2)
  199.         PEA.L    tempL(A6)                    ;
  200.         BSR        ZeroToNum                    ;
  201.         ADDQ.L    #8,SP                        ;
  202.         MOVE.W    tempL+2(A6),res(A6)            ;
  203.         
  204.         CMPI.W    #0,res(A6)                    ; if (res <= 0)
  205.         BGT.S    @110                        ; 
  206.         MOVE.W    #1,res(A6)                    ;     res = 1
  207. @110
  208.  
  209.         CMPI.W    #4,XCmdParamCount(A3)        ; if (paramPtr->paramCount>3)
  210.         BLT        @150                        ;
  211.         MOVE.L    XCmdParams+12(A3),-(SP)        ; limit = ParamToNum(paramPtr,3)
  212.         PEA.L    tempL(A6)                    ;
  213.         BSR        ZeroToNum                    ;
  214.         ADDQ.L    #8,SP                        ;
  215.         MOVE.W    tempL+2(A6),limit(A6)        ;
  216.         
  217.         CMPI.W    #3,limit(A6)                ; if (limit<4) 
  218.         BGT.S    @120                        ;
  219.         MOVE.W    #4,limit(A6)                ;     limit = 4
  220. @120
  221.  
  222.         CMPI.W    #5,XCmdParamCount(A3)        ; if (paramPtr->paramCount>4)
  223.         BLT        @150                        ;
  224.         MOVE.L    XCmdParams+16(A3),-(SP)        ; nolock = !ParamToNum(paramPtr,4)
  225.         PEA.L    tempL(A6)                    ;
  226.         BSR        ZeroToNum                    ;
  227.         ADDQ.L    #8,SP                        ;
  228.         MOVE.W    tempL+2(A6),nolock(A6)        ;
  229.         NOT.W    nolock(A6)                    ;
  230. @150
  231.  
  232. ;    /* map screen onto -2 to 2 range */
  233. ;    
  234. ;    /* 0,0 is at 512/2, 342/2 = 256,171 */
  235. ;    
  236. ;    /* gridding to res requires that I find out how many boxes wide and tall
  237. ;       the image is, and map each box onto a value in r2.  then i iterate over
  238. ;       all the boxes calling the function until the x or y exceeds some limit.
  239. ;       then i map the number of iterations into a 'color' */
  240. ;       
  241. ;    /* since we don't have a global data area for extended constants to live in,
  242. ;       use longs and fake the compiler into making the correct SANE calls to 
  243. ;       build the extended values.  Is there a better way (besides using Pascal!) */
  244. ;
  245.         MOVE.L    #256,fake256(A6)            ; fake256 = 256
  246.         
  247.         MOVE.L    #171,fake171(A6)            ; fake171 = 171
  248.         
  249.         MOVE.L    #2,fake2(A6)                ; fake2 = 2
  250.         
  251.         MOVE.L    #100,fake100(A6)            ; fake100 = 100
  252.  
  253.         MOVE.L    #256,D0                        ; hsize = (fake256/res)+1
  254.         DIVS.W    res(A6),D0                    ;
  255.         ADDQ.W    #1,D0                        ;
  256.         MOVE.W    D0,hsize(A6)                ;
  257.         
  258.         MOVE.L    #171,D0                        ; vsize = (fake171/res)+1
  259.         DIVS.W    res(A6),D0                    ;
  260.         ADDQ.W    #1,D0                        ;
  261.         MOVE.W    D0,vsize(A6)                ;
  262.         
  263.         FMOVECR.X #$34,FP0                    ; real100 = fake100
  264.         FMOVE.X    FP0,real100(A6)                ;
  265.         
  266.         FMOVE.W    #2,FP0                        ; real2 = fake2
  267.         FMOVE.X    FP0,real2(A6)                ;
  268.         
  269.         FMOVE.W    #-2,FP0                        ; realn2 = -fake2
  270.         FMOVE.X    FP0,realn2(A6)                ;
  271.         
  272.         FMOVE.X    real2(A6),FP0                ; rat = real2/hsize
  273.         FDIV.W    hsize(A6),FP0                ;
  274.         FMOVE.X    FP0,rat(A6)                    ; /* reals intermediate result because of real2 */
  275.         
  276.         MOVE.W    res(A6),D0                    ; rbaseh = 256-hsize*res
  277.         MULS.W    hsize(A6),D0                ;
  278.         MOVE.W    #256,D1                        ;
  279.         SUB.W    D0,D1                        ;
  280.         MOVE.W    D1,rbaseh(A6)                ;
  281.         
  282.         MOVE.W    res(A6),D0                    ; r.top = 171-vsize*res
  283.         MULS.W    vsize(A6),D0                ;
  284.         MOVE.W    #171,D1                        ;
  285.         SUB.W    D0,D1                        ;
  286.         MOVE.W    D1,r(A6)                    ;
  287.         
  288.         ADD.W    res(A6),D1                    ; r.bottom = r.top + res
  289.         MOVE.W    D1,r+4(A6)                    ;
  290.         
  291.         FMOVE.L    fake171(A6),FP2                ; basev = realn2*fake171/fake256
  292.         FMUL.X    realn2(A6),FP2                ; /* center it */
  293.         FDIV.L    fake256(A6),FP2                ;
  294.         
  295. ;            for loop
  296.         
  297.         MOVE.W    vsize(A6),i(A6)                ; for (i=-vsize; i<vsize; ++i)
  298.         NEG.W    i(A6)                        ;
  299. @200
  300.         MOVE.W    vsize(A6),D0                ;
  301.         CMP.W    i(A6),D0                    ;
  302.         BLE        @500                        ;
  303.         
  304.         MOVE.W    rbaseh(A6),r+2(A6)            ; r.left = rbaseh
  305.         
  306.         MOVE.W    r+2(A6),D0                    ; r.right = r.left + res
  307.         ADD.W    res(A6),D0                    ;
  308.         MOVE.W    D0,r+6(A6)                    ;
  309.         
  310.         FMOVE.X    realn2(A6),FP3                ; baseh = realn2
  311.         
  312. ;            for loop
  313.  
  314.         MOVE.W    hsize(A6),j(A6)                ; for (j=-hsize; j<hsize; ++j)
  315.         NEG.W    j(A6)                        ;
  316. @250
  317.         MOVE.W    hsize(A6),D0                ;
  318.         CMP.W    j(A6),D0                    ;
  319.         BLE        @450                        ;
  320.         
  321.         FMOVE.X    FP3,FP5                        ; valh = baseh
  322.         
  323.         FMOVE.X    FP2,FP4                        ; valv = basev
  324.         
  325.         MOVE.W    #0,iter(A6)                    ; iter = 0
  326.         
  327. ;            do loop
  328.  
  329. @300
  330. ;
  331. ;
  332. ;    register assignments to speed up loop
  333. ;
  334. ;        hsq is in FP7
  335. ;        vsq is in FP6
  336. ;        valh is in FP5
  337. ;        valv is in FP4
  338. ;        baseh is in FP3
  339. ;        basev is in FP2
  340. ;
  341.         
  342.         FMOVE.X    FP5,FP7                        ; hsq = valh * valh
  343.         FMUL.X    FP7,FP7                        ;
  344.         
  345.         FMOVE.X    FP4,FP6                        ; vsq = valv * valv
  346.         FMUL.X    FP6,FP6                        ;
  347.         
  348.         FMOVE.X    FP7,FP1
  349.         FSUB.X    FP6,FP1                        ; temp = hsq - vsq + seedv
  350.         FADD.X    seedh(A6),FP1                ;
  351.         
  352.         FMOVE.X    real2(A6),FP0                ; valv = real2*valh*valv + seedv
  353.         FMUL.X    FP5,FP0                        ;
  354.         FMUL.X    FP0,FP4                        ;
  355.         FADD.X    seedv(A6),FP4                ;
  356.         
  357.         FMOVE.X    FP1,FP5                        ; valh = temp
  358.         
  359.         ADDQ.W    #1,iter(A6)                    ; ++iter
  360.         
  361.         FMOVE.X    FP7,FP0                        ; while ((hsq+vsq<real100) && (iter<limit))
  362.         FADD.X    FP6,FP0                        ;
  363.         FMOVECR.X #$34,FP1                    ;
  364.         FCMP.X    FP0,FP1                        ;
  365.         FBLE.W    @350                        ;
  366.         MOVE.W    limit(A6),D0                ;
  367.         CMP.W    iter(A6),D0                    ;
  368.         BGE        @300                        ;
  369.  
  370. @350
  371.         
  372.         MOVE.W    iter(A6),D0                    ; PenPat(&pats[iter & 0x03])
  373.         ANDI.W    #3,D0                        ;
  374.         MULU    #8,D0                        ;
  375.         LEA.L    pats(A6),A0                    ;
  376.         ADDA.W    D0,A0                        ;
  377.         MOVE.L    A0,-(SP)                    ;
  378.         _PenPat                                ;
  379.         
  380.         PEA.L    r(A6)                        ; PaintRect(&r)
  381.         _PaintRect                            ;
  382.         
  383.         MOVE.W    res(A6),D0                    ; r.left += res
  384.         ADD.W    D0,r+2(A6)                    ;
  385.         
  386.         ADD.W    D0,r+6(A6)                    ; r.right += res
  387.         
  388.         FADD.X    rat(A6),FP3                    ; baseh += rat
  389.         
  390.         TST.W    nolock(A6)                    ; if (nolock && Button()) return
  391.         BEQ.S    @425                        ;
  392.         CLR.W    -(SP)                        ;
  393.         _Button                                ;
  394.         TST.W    (SP)+                        ;
  395.         BNE        FracsDone                    ;
  396. @425
  397.         
  398.         ADDQ.W    #1,j(A6)                    ;
  399.         BRA        @250                        ;
  400.  
  401. @450
  402.  
  403.         MOVE.W    res(A6),D0                    ; r.top += res
  404.         ADD.W    D0,r(A6)                    ;
  405.         
  406.         ADD.W    D0,r+4(A6)                    ; r.bottom += res
  407.         
  408.         FADD.X    rat(A6),FP2                    ; basev += rat
  409.         
  410.         ADDQ.W    #1,i(A6)                    ;
  411.         BRA        @200                        ;
  412.  
  413. @500
  414. FracsDone
  415.         MOVEM.L    (SP)+,A0-A6/D0-D7        ; restore registers
  416.         UNLK    A6
  417.         MOVE.L    (SP)+,(SP)
  418.         RTS
  419.  
  420. ZeroToNum
  421.         MOVE.L    xcmdBlockAddr(A6),A3    ; xcmd blk ptr
  422.         MOVE.L    8(SP),A0                ; handle to num string
  423.         MOVE.L    (A0),XCmdInArgs(A3)        ; ptr to num string
  424.         LEA.L    tempStr(A6),A0            ; pt to temp string area
  425.         MOVE.L    A0,XCmdInArgs+4(A3)        ; set temp string ptr
  426.         MOVE.W    #xreqZeroToPas,XCmdRequest(A3) ; convert to pascal string
  427.         MOVE.L    XCmdEntryPoint(A3),A0    ; get entry point addr
  428.         JSR        (A0)                    ; call HC
  429.         LEA.L    tempStr(A6),A0            ; pt to temp string area
  430.         MOVE.L    A0,XCmdInArgs(A3)        ; set first arg
  431.         MOVE.W    #xreqStrToNum,XCmdRequest(A3) ; set req code
  432.         MOVE.L    XCmdEntryPoint(A3),A0    ; get entry point addr
  433.         JSR        (A0)                    ; call HC
  434.         MOVE.L    4(SP),A0                ; ptr to result field
  435.         MOVE.L    XCmdOutArgs(A3),(A0)    ; set result
  436.         RTS                                ;
  437.  
  438. ZeroToExt
  439.         MOVE.L    xcmdBlockAddr(A6),A3    ; xcmd blk ptr
  440.         MOVE.L    8(SP),A0                ; handle to num string
  441.         MOVE.L    (A0),XCmdInArgs(A3)        ; ptr to num string
  442.         LEA.L    tempStr(A6),A0            ; pt to temp string area
  443.         MOVE.L    A0,XCmdInArgs+4(A3)        ; set temp string ptr
  444.         MOVE.W    #xreqZeroToPas,XCmdRequest(A3) ; convert to pascal string
  445.         MOVE.L    XCmdEntryPoint(A3),A0    ; get entry point addr
  446.         JSR        (A0)                    ; call HC
  447.         LEA.L    tempStr(A6),A0            ; pt to temp string area
  448.         MOVE.L    A0,XCmdInArgs(A3)        ; set first arg
  449.         LEA.L    tempX(A6),A0            ; pt to temp string area
  450.         MOVE.L    A0,XCmdInArgs+4(A3)        ; set first arg
  451.         MOVE.W    #xreqStrToExt,XCmdRequest(A3) ; set req code
  452.         MOVE.L    XCmdEntryPoint(A3),A0    ; get entry point addr
  453.         JSR        (A0)                    ; call HC
  454.         MOVE.L    4(SP),A0                ; ptr to result field
  455.         MOVE.W    tempX(A6),(A0)+            ; set result
  456.         CLR.W    (A0)+                    ; fill in the zeros
  457.         MOVE.L    tempX+2(A6),(A0)+        ; set result
  458.         MOVE.L    tempX+6(A6),(A0)+        ; set result
  459.         RTS                                ;
  460.  
  461.  
  462.             ENDWITH
  463.             ENDMAIN
  464.             END
  465.  
  466.